home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cocktail / mpp.lha / mpp / src / Table.mi < prev   
Text File  |  1992-08-18  |  2KB  |  97 lines
  1. (* $Id: Table.mi,v 1.1 1989/04/14 12:21:55 vielsack rel $ *)
  2.  
  3. IMPLEMENTATION MODULE Table;
  4.  
  5. FROM IO        IMPORT    StdOutput;
  6. FROM StdIO    IMPORT    WriteNl, WriteC;
  7. FROM Strings    IMPORT    tString, AssignEmpty, Length, Char, Assign, WriteS;
  8.  
  9. VAR 
  10.   empty: tString;
  11.   outside: BOOLEAN;
  12.   table: ARRAY CHAR OF tString;
  13.   c: CHAR;
  14.  
  15. PROCEDURE Define    (letter: CHAR; VAR definition: tString);
  16.   BEGIN
  17.     Assign (table [letter], definition);
  18.   END Define;
  19.  
  20. PROCEDURE Translate    (letter: CHAR; VAR text: tString);
  21.   VAR def: tString; l,i: INTEGER;
  22.   BEGIN
  23.     Assign (def, table [letter]);
  24.     i := 0;
  25.     l := Length (def);
  26.     LOOP
  27.       IF i = l THEN EXIT END;
  28.       INC (i);
  29.       c := Char (def, i);
  30.       IF c = '%' THEN
  31.     WriteText (text);
  32.       ELSIF c = '\' THEN
  33.     IF i < l THEN
  34.       INC (i);
  35.       c := Char (def, i);
  36.       WriteC (c);
  37.     END;
  38.       ELSE
  39.     WriteC (c);
  40.       END;
  41.     END;
  42.   END Translate;
  43.  
  44. PROCEDURE WriteText    (VAR text: tString);
  45.   VAR i,l: INTEGER; c: CHAR;
  46.   BEGIN
  47.     i := 0;
  48.     l := Length (text);
  49.     LOOP
  50.       IF i = l THEN EXIT END;
  51.       INC (i);
  52.       c := Char (text, i);
  53.       IF c = '\' THEN
  54.     IF i < l THEN
  55.       INC (i);
  56.       c := Char (text, i);
  57.       WriteC (c);
  58.     END;
  59.       ELSE
  60.     WriteC (c);
  61.       END;
  62.     END;
  63.   END WriteText;
  64.  
  65. PROCEDURE BeginLine    ;
  66.   BEGIN
  67.     IF outside THEN
  68.       Translate ('^', empty);
  69.       outside := FALSE;
  70.     END;
  71.   END BeginLine;
  72.  
  73. PROCEDURE CloseLine    ;
  74.   BEGIN
  75.     Translate ('$', empty);
  76.     outside := TRUE;
  77.   END CloseLine;
  78.  
  79. PROCEDURE WriteLine    (VAR text: tString);
  80.   BEGIN
  81.     WriteS (StdOutput, text);
  82.   END WriteLine;
  83.  
  84. PROCEDURE NewLine    ;
  85.   BEGIN
  86.     WriteNl;
  87.   END NewLine;
  88.  
  89.  
  90. BEGIN
  91.   outside := TRUE;
  92.   AssignEmpty (empty);
  93.   FOR c := MIN (CHAR) TO MAX (CHAR) DO
  94.     AssignEmpty (table [c]);
  95.   END;
  96. END Table.
  97.